home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / reqtools / examples / rtdemo.pas
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  16.5 KB  |  412 lines
  1. PROGRAM RTDemo;
  2.  
  3. (*
  4. **  This is a straight translation from demo.c
  5. **  in the reqtools archive.
  6. **
  7. **  Check this demo for tips on how to use
  8. **  reqtools in FPC Pascal.
  9. **
  10. **  nils.sjoholm@mailbox.swipnet.se  (Nils Sjoholm)
  11. **
  12. *)
  13.  
  14. uses reqtools, strings, utility,vartags;
  15.  
  16.  
  17.  
  18. CONST
  19.     DISKINSERTED=$00008000;
  20.  
  21.  
  22. VAR
  23.     filereq         : prtFileRequester;
  24.     fontreq         : prtFontRequester;
  25.     scrnreq         : prtScreenModeRequester;
  26.     filelist        : prtFileList;
  27.     buffer          : PChar;
  28.     filename        : PChar;
  29.     dummy           : PChar;
  30.     dummy2          : PChar;
  31.     longnum         : Longint;
  32.     ret             : Longint;
  33.     color           : Longint;
  34.     values          : ARRAY [0..5] OF Longint;
  35.     undertag        : Array [0..1] of tTagItem;
  36.  
  37. FUNCTION GetScrollValue(value : INTEGER): STRING;
  38. BEGIN
  39.     IF value = 0 THEN GetScrollValue := 'Off'
  40.     ELSE GetScrollValue := 'On';
  41. END;
  42.  
  43. PROCEDURE CleanUp;
  44. BEGIN
  45.     if assigned(dummy) then StrDispose(dummy);
  46.     if assigned(dummy2) then StrDispose(dummy2);
  47.     if assigned(buffer) then StrDispose(buffer);
  48.     if assigned(filename) then StrDispose(filename);
  49. END;
  50.  
  51. BEGIN
  52.     dummy:= StrAlloc(400);
  53.     dummy2 := StrAlloc(200);
  54.  
  55.     undertag[0] := TagItem(RT_UnderScore,Longint(byte('_')));
  56.     undertag[1].ti_Tag := TAG_END;
  57.  
  58.     rtEZRequestA('ReqTools 2.0 Demo' + #10 +
  59.            '~~~~~~~~~~~~~~~~~' + #10 +
  60.            '''reqtools.library'' offers several' + #10 +
  61.            'different types of requesters:','Let''s see them', NIL, NIL, NIL);
  62.  
  63.     rtEZRequestA('NUMBER 1:' + #10 + 'The larch :-)',
  64.                      'Be serious!', NIL, NIL, NIL);
  65.  
  66.     rtEZRequestA('NUMBER 1:' + #10 + 'String requester' + #10 + 'function:rtGetString()',
  67.                      'Show me', NIL, NIL, NIL);
  68.  
  69.     buffer:= StrAlloc(128);      { This should alloc'd to maxchars + 1 }
  70.  
  71.     StrPCopy(buffer, 'A bit of text');
  72.  
  73.     ret := rtGetStringA (buffer, 127, 'Enter anything:', NIL, NIL);
  74.     values[0] := Longint(buffer);
  75.  
  76.     IF (ret=0) THEN
  77.         rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
  78.     ELSE
  79.         rtEZRequestA('You entered this string:' + #10 + '%s','So I did', NIL, 
  80. @values[0], NIL);
  81.  
  82.     ret := rtGetStringA(buffer, 127, 'Enter anything:', NIL,TAGS(
  83.                 RTGS_GadFmt, longstr(' _Ok |New _2.0 feature!|_Cancel'),
  84.                 RTGS_TextFmt, longstr('These are two new features of ReqTools 2.0:' + #10
  85.                 + 'Text above the entry gadget and more than' + #10 + 'one response gadget.'),
  86.                 TAG_MORE, Longint(@undertag),0));
  87.  
  88.                       
  89.  
  90.     IF ret=2 THEN
  91.         rtEZRequestA('Yep, this is a new' + #10 + 'ReqTools 2.0 feature!',
  92.                        'Oh boy!',NIL,NIL,NIL);
  93.  
  94.     ret := rtGetStringA(buffer, 127, 'Enter anything:',NIL,TAGS(
  95.                         RTGS_GadFmt,longstr(' _Ok | _Abort |_Cancel'),
  96.                         RTGS_TextFmt,longstr('New is also the ability to switch off the' + #10 +
  97.                         'backfill pattern.  You can also center the' + #10 +
  98.                         'text above the entry gadget.' + #10 +
  99.                         'These new features are also available in' + #10 +
  100.                         'the rtGetLong() requester.'),
  101.                         RTGS_BackFill, longint(byte(FALSE)),
  102.                         RTGS_Flags, GSREQF_CENTERTEXT + GSREQF_HIGHLIGHTTEXT,
  103.                         TAG_MORE, longint(@undertag),0));
  104.  
  105.     IF ret = 2 THEN
  106.         rtEZRequestA('What!! You pressed abort!?!' + #10 + 'You must be joking :-)',
  107.                              'Ok, Continue',NIL,NIL,NIL);
  108.  
  109.     rtEZRequestA ('NUMBER 2:' + #10 + 'Number requester' + #10 + 'function:rtGetLong()',
  110.                      'Show me', NIL, NIL, NIL);
  111.  
  112.     ret := rtGetLongA(longnum, 'Enter a number:',NIL,TAGS(
  113.                       RTGL_ShowDefault, longint(byte(FALSE)),
  114.                       RTGL_Min, 0,
  115.                       RTGL_Max, 666,
  116.                       TAG_DONE));
  117.  
  118.     values[0] := Longint(longnum);
  119.  
  120.     IF(ret=0) THEN
  121.         rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
  122.     ELSE
  123.         rtEZRequestA('The number You entered was:'  + #10 + '%ld' ,
  124.                      'So it was', NIL, @values[0], NIL);
  125.  
  126.     rtEZRequestA ('NUMBER 3:' + #10 + 'Notification requester, the requester' + #10 +
  127.                          'you''ve been using all the time!' + #10 +
  128.                          'function: rtEZRequestA()','Show me more', NIL, NIL, NIL);
  129.  
  130.     rtEZRequestA ('Simplest usage: some body text and' + #10 + 'a single centered gadget.',
  131.                          'Got it', NIL, NIL, NIL);
  132.  
  133.     ret := 0;
  134.     WHILE ret = 0 DO BEGIN
  135.         ret := rtEZRequestA ('You can also use two gadgets to' + #10 +
  136.                              'ask the user something' + #10 +
  137.                              'Do you understand?',
  138.                              'Of course|Not really', NIL, NIL, NIL);
  139.         IF ret = 0 THEN rtEZRequestA ('You are not one of the brightest are you?' + 
  140.                                        #10 + 'We''ll try again...',
  141.                                       'Ok', NIL, NIL, NIL);
  142.     END;
  143.  
  144.     rtEZRequestA ('Great, we''ll continue then.', 'Fine', NIL, NIL, NIL);
  145.  
  146.     ret:=rtEZRequestA ('You can also put up a requester with' + #10 +
  147.                        'three choices.' + #10 +
  148.                        'How do you like the demo so far ?',
  149.                        'Great|So so|Rubbish', NIL, NIL, NIL);
  150.     CASE ret OF
  151.         0:  rtEZRequestA ('Too bad, I really hoped you' + #10 + 'would like it better.',
  152.                                'So what', NIL, NIL, NIL);
  153.  
  154.         1:  rtEZRequestA ('I''m glad you like it so much.','Fine', NIL, NIL, NIL);
  155.  
  156.         2:  rtEZRequestA ('Maybe if you run the demo again' + #10 + 'you''ll REALLY like it.',
  157.                                'Perhaps', NIL, NIL, NIL);
  158.     END;
  159.  
  160.     ret := rtEZRequestA('The number of responses is not limited to three' + #10 +
  161.                             'as you can see.  The gadgets are labeled with' + #10 +
  162.                             'the ''Return'' code from rtEZRequestA().' + #10 +
  163.                             'Pressing ''Return'' will choose 4, note that' + #10 +
  164.                             '4''s button text is printed in boldface.',
  165.                             '1|2|3|4|5|0', NIL, NIL,TAGS(
  166.                             RTEZ_DefaultResponse, 4,
  167.                             TAG_DONE));
  168.                           
  169.     values[0] := Longint(ret);
  170.     rtEZRequestA('You picked ''%ld''.', 'How true', NIL, @values[0],NIL);
  171.  
  172.     {
  173.       If i used just a string for this text is will be truncated
  174.       after 255 chars. There are no strpcat in strings so we
  175.       have to use two buffers and then use strcat.
  176.     }
  177.     strpcopy(dummy,'New for Release 2.0 of ReqTools (V38) is' + #10 +
  178.                    'the possibility to define characters in the' + #10 +
  179.                    'buttons as keyboard shortcuts.' + #10 +
  180.                    'As you can see these characters are underlined.' + #10 +
  181.                    'Pressing shift while still holding down the key' + #10 +
  182.                    'will cancel the shortcut.' + #10);
  183.     {
  184.       The second buffer.
  185.     }
  186.     strpcopy(dummy2,'Note that in other requesters a string gadget may' + #10 +
  187.                    'be active.  To use the keyboard shortcuts there' + #10 +
  188.                    'you have to keep the Right Amiga key pressed down.');
  189.     {
  190.       Now put them together
  191.     }
  192.     strcat(dummy,dummy2);
  193.  
  194.     rtEZRequestA(dummy,'_Great|_Fantastic|_Swell|Oh _Boy',NIL,NIL,@undertag);
  195.  
  196.  
  197.     values[0]:=5;
  198.     values[1]:=Longstr('five');
  199.     rtEZRequestA('You may also use C-style formatting codes in the body text.' + #10 +
  200.                         'Like this:' + #10 +  + #10 +
  201.                         'The number %%ld is written %%s. will give:' + #10 +  + #10 +
  202.                         'The number %ld is written %s.' + #10 +  + #10 +
  203.                         'if you also pass ''5'' and ''five'' to rtEZRequestA().',
  204.                         '_Proceed',NIL,@values[0],@undertag);
  205.  
  206.     ret := rtEZRequestA('It is also possible to pass extra IDCMP flags' + #10 +
  207.                         'that will satisfy rtEZRequest(). This requester' + #10 +
  208.                         'has had DISKINSERTED passed to it.' + #10 +
  209.                         '(Try inserting a disk).', '_Continue', NIL,NIL,TAGS(
  210.                         RT_IDCMPFlags, DISKINSERTED,
  211.                         TAG_MORE, Longint(@undertag),0));
  212.  
  213.     IF ((ret = DISKINSERTED)) THEN
  214.         rtEZRequestA('You inserted a disk.', 'I did', NIL, NIL, NIL)
  215.     ELSE
  216.         rtEZRequestA('You Used the ''Continue'' gadget' + #10 +
  217.                           'to satisfy the requester.','I did', NIL, NIL, NIL);
  218.  
  219.     rtEZRequestA('Finally, it is possible to specify the position' + #10 +
  220.                         'of the requester.' + #10 +
  221.                         'E.g. at the top left of the screen, like this.' + #10 +
  222.                         'This works for all requesters, not just rtEZRequest()!',
  223.                         '_Amazing', NIL,NIL,TAGS(
  224.                         RT_ReqPos, REQPOS_TOPLEFTSCR,
  225.                         TAG_MORE, longint(@undertag),0));
  226.  
  227.     rtEZRequestA('Alternatively, you can center the' + #10 +
  228.                         'requester on the screen.' + #10 +
  229.                         'Check out ''reqtools.doc'' for all the possibilities.',
  230.                         'I''ll do that', NIL,NIL,TAGS(
  231.                         RT_ReqPos, REQPOS_CENTERSCR,
  232.                         TAG_MORE, Longint(@undertag),0));
  233.  
  234.  
  235.     ret := rtEZRequestA('NUMBER 4:' + #10 + 'File requester' + #10 + 'function: rtFileRequest()',
  236.                           '_Demonstrate', NIL, NIL, @undertag);
  237.  
  238.     filereq := rtAllocRequestA(RT_FILEREQ, NIL);
  239.  
  240.     IF (filereq<>NIL) THEN BEGIN
  241.         filename := StrAlloc(80);
  242.         strpcopy (filename, '');
  243.         {
  244.           We have to cast rtFileRequester to an Longint
  245.           to keep the compiler happy.
  246.         }
  247.         ret := Longint(rtFileRequestA(filereq, filename, 'Pick a file', NIL));
  248.         IF (ret)<>0 THEN begin
  249.             values[0] := Longint(filename);
  250.             values[1] := Longint(filereq^.Dir);
  251.             rtEZRequestA('You picked the file:' + #10 + '%s' + #10 + 'in directory:'
  252.                                 + #10 + '%s', 'Right', NIL, @values[0],NIL)
  253.         END
  254.         ELSE
  255.             rtEZRequestA('You didn''t pick a file.', 'No', NIL, NIL, NIL);
  256.  
  257.         rtEZRequestA('The file requester has the ability' + #10 +
  258.                      'to allow you to pick more than one' + #10 +
  259.                      'file (use Shift to extend-select).' + #10 +
  260.                      'Note the extra gadgets you get.',
  261.                      '_Interesting', NIL,NIL, @undertag);
  262.  
  263.         filelist := rtFileRequestA(filereq,filename,'Pick some files',TAGS(
  264.                                    RTFI_Flags, FREQF_MULTISELECT,
  265.                                    TAG_END));
  266.  
  267.         IF filelist <> NIL THEN BEGIN
  268.             values[0] := Longint(filelist^.Name);
  269.             rtEZRequestA('You selected some files, this is' + #10 +
  270.                           'the first one:' + #10 +
  271.                           '"%s"' + #10 +
  272.                           'All the files are returned as a linked' + #10 +
  273.                           'list (see demo.c and reqtools.h).',
  274.                           'Aha', NIL, @values[0],NIL);
  275.             (* Traverse all selected files *)
  276.             (*
  277.             tempflist = flist;
  278.             while (tempflist) {
  279.                 DoSomething (tempflist->Name, tempflist->StrLen);
  280.                 tempflist = tempflist->Next;
  281.                 }
  282.             *)
  283.             (* Free filelist when no longer needed! *)
  284.             rtFreeFileList(filelist);
  285.         END;
  286.         rtFreeRequest(filereq);
  287.     END
  288.     ELSE
  289.         rtEZRequestA('Out of memory!', 'Oh boy!', NIL, NIL, NIL);
  290.  
  291.     rtEZRequestA('The file requester can be used' + #10 + 'as a directory requester as well.',
  292.                     'Let''s _see that', NIL, NIL, @undertag);
  293.  
  294.     filereq := rtAllocRequestA(RT_FILEREQ, NIL);
  295.     IF (filereq<>NIL) THEN BEGIN
  296.         
  297.          ret := Longint(rtFileRequestA(filereq, filename, 'Pick a directory',TAGS(
  298.                                        RTFI_Flags, FREQF_NOFILES,
  299.                                        TAG_END)));
  300.  
  301.          IF(ret=1) THEN begin
  302.              values[0] := Longint(filereq^.Dir);
  303.              rtEZRequestA('You picked the directory:' + #10 +'%s',
  304.                           'Right', NIL, @values[0], NIL);
  305.          end ELSE
  306.              rtEZRequestA('You didn''t pick a directory.', 'No', NIL, NIL, NIL);
  307.  
  308.          rtFreeRequest(filereq);
  309.     END
  310.     ELSE
  311.          ret := rtEZRequestA('Out of memory','No',NIL,NIL,NIL);
  312.  
  313.     rtEZRequestA('NUMBER 5:' + #10 +' Font requester' + #10 + 'function:rtFontRequest()',
  314.                           'Show', NIL, NIL, NIL);
  315.  
  316.     fontreq := rtAllocRequestA(RT_FONTREQ, NIL);
  317.     IF (fontreq<>NIL) THEN BEGIN
  318.          fontreq^.Flags := FREQF_STYLE OR FREQF_COLORFONTS;
  319.          ret := rtFontRequestA (fontreq, 'Pick a font', NIL);
  320.          IF(ret<>0) THEN begin
  321.              values[0] := Longint(fontreq^.Attr.ta_Name);
  322.              values[1] := Longint(fontreq^.Attr.ta_YSize);
  323.              rtEZRequestA('You picked the font:' + #10 + '%s' + #10 + 'with size:' + 
  324.                           #10 + '%ld',
  325.                          'Right', NIL, @values[0],NIL);
  326.          end ELSE
  327.              ret := rtEZRequestA('You didn''t pick a font','I know', NIL, NIL, NIL);
  328.          rtFreeRequest(fontreq);
  329.     END
  330.     ELSE
  331.          rtEZRequestA('Out of memory!', 'Oh boy!', NIL, NIL, NIL);
  332.  
  333.     rtEZRequestA('NUMBER 6:' + #10 + 'Palette requester' + #10 + 'function:rtPaletteRequest()',
  334.                  '_Proceed', NIL,NIL, @undertag);
  335.  
  336.     color := rtPaletteRequestA('Change palette',NIL,NIL);
  337.     IF (color = -1) THEN
  338.         rtEZRequestA('You canceled.' + #10 + 'No nice colors to be picked ?',
  339.                          'Nah', NIL, NIL, NIL)
  340.     ELSE begin
  341.         values[0] := Longint(color);
  342.         rtEZRequestA('You picked color number %ld.', 'Sure did',
  343.                          NIL, @values[0], NIL);
  344.     END;
  345.  
  346.     rtEZRequestA('NUMBER 7: (ReqTools 2.0)' + #10 +
  347.                  'Volume requester' + #10 +
  348.                  'function: rtFileRequest() with' + #10 +
  349.                  'RTFI_VolumeRequest tag.',
  350.                  '_Show me', NIL, NIL, @undertag);
  351.  
  352.     filereq := rtAllocRequestA(RT_FILEREQ,NIL);
  353.     IF (filereq <> NIL) THEN BEGIN
  354.         
  355.         ret := Longint(rtFileRequestA(filereq,NIL,'Pick a volume!',TAGS(
  356.                                       RTFI_VolumeRequest,0,
  357.                                       TAG_END)));
  358.         IF (ret = 1) THEN begin
  359.             values[0] := Longint(filereq^.Dir);
  360.             rtEZRequestA('You picked the volume:' + #10 + '%s',
  361.                         'Right',NIL, @values,NIL);
  362.         end
  363.         ELSE
  364.             rtEZRequestA('You didn''t pick a volume.','I did not',NIL,NIL,NIL);
  365.         rtFreeRequest(filereq);
  366.     END
  367.     ELSE
  368.         rtEZRequestA('Out of memory','Oh boy!',NIL,NIL,NIL);
  369.  
  370.     rtEZRequestA('NUMBER 8: (ReqTools 2.0)' + #10 +
  371.                  'Screen mode requester' + #10 +
  372.                  'function: rtScreenModeRequest()' + #10 +
  373.                  'Only available on Kickstart 2.0!',
  374.                  '_Proceed', NIL, NIL, @undertag);
  375.  
  376.     scrnreq := rtAllocRequestA (RT_SCREENMODEREQ, NIL);
  377.     IF (scrnreq<>NIL) THEN BEGIN
  378.         
  379.         ret := rtScreenModeRequestA( scrnreq, 'Pick a screen mode:',TAGS(
  380.                                      RTSC_Flags, SCREQF_DEPTHGAD OR SCREQF_SIZEGADS OR
  381.                                      SCREQF_AUTOSCROLLGAD OR SCREQF_OVERSCANGAD,
  382.                                      TAG_END));
  383.  
  384.         IF(ret=1) THEN BEGIN
  385.             values[0] := Longint(scrnreq^.DisplayID);
  386.             values[1] := Longint(scrnreq^.DisplayWidth);
  387.             values[2] := Longint(scrnreq^.DisplayHeight);
  388.             values[3] := Longint(scrnreq^.DisplayDepth);
  389.             values[4] := Longint(scrnreq^.OverscanType);
  390.             values[5] := longstr(GetScrollValue(scrnreq^.AutoScroll));
  391.  
  392.             rtEZRequestA('You picked this mode:' + #10 +
  393.                          'ModeID  : 0x%lx' + #10 +
  394.                          'Size    : %ld x %ld' + #10 +
  395.                          'Depth   : %ld' + #10 +
  396.                          'Overscan: %ld' + #10 +
  397.                          'AutoScroll %s',
  398.                          'Right', NIL, @values, NIL);
  399.         END
  400.         ELSE
  401.             rtEZRequestA('You didn''t pick a screen mode.', 'Sorry', NIL, NIL, NIL);
  402.         rtFreeRequest (scrnreq);
  403.     END
  404.     ELSE
  405.     rtEZRequestA('Out of memory!', 'Oh boy!', NIL, NIL, NIL);
  406.  
  407.  
  408.     rtEZRequestA('That''s it!' + #10 + 'Hope you enjoyed the demo', '_Sure did', NIL, 
  409.                     NIL,@undertag);
  410.     CleanUp;
  411. END.
  412.